---
output:
  bookdown::pdf_document2:
    toc: yes
    number_sections: yes
    pandoc_args: !expr rmdfiltr::add_wordcount_filter(rmdfiltr::add_citeproc_filter(args = NULL))
    # latex_engine: xelatex
    keep_tex: no
header-includes:
  - \usepackage{bbm}
  - \usepackage{float}

editor_options:
  chunk_output_type: console

citeproc: no

fontsize: 12pt
geometry: margin=1in
indent: yes
link-citations: yes
linkcolor: blue
title: "Online Appendix"
subtitle: "How Sexuality Affects Evaluations of Immigrant Deservingness and Cultural Similarity: A Conjoint Survey Experiment"
author:
- Nathan I. Hoffmann^[Department of Sociology, University of California, Los Angeles, nathanihoff@ucla.edu]
- Kristopher Velasco^[Department of Sociology, Princeton University, kvelasco@princeton.edu]
---

\newcommand{\tabitem}{~~\llap{\textbullet}~~}

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = F, warning = F, message = F, cache = T, 
                      dpi = 300)

library(here)
library(huxtable)
library(haven)
library(patchwork)
library(cregg)
library(rdss)
library(DeclareDesign)
library(survey)
library(srvyr)
library(tidyverse)

options("yaml.eval.expr" = TRUE)

theme_set(theme_classic(base_family = 'Palatino') + 
            theme(legend.title=element_blank(),
                  panel.grid.major.y = element_line('grey80'),
                  legend.background = element_rect(fill = "transparent")))
ggplot <- function(...) ggplot2::ggplot(...) + scale_color_brewer(palette="Dark2") +
  scale_fill_brewer(palette="Dark2")

```

```{r load}
prolific <- read_csv(here('data', 'prolific.csv')) %>%
  filter(Status == 'APPROVED' | Status == 'AWAITING REVIEW')
col_names <- names(read_csv(here('data', 'survey.csv'), n_max = 0))
survey_raw <- read_csv(here('data', 'survey.csv'), col_names = col_names, skip = 3) %>%
  filter(PROLIFIC_PID %in% prolific$`Participant id`,
         PROLIFIC_PID != '644af405d31dd25adf037157', # failed attention check
         PROLIFIC_PID != '6048622d518a190008dfbe38', # extra person
         Finished == T)

survey <- survey_raw %>%
  pivot_longer(c(gender1:reason4, rating1:value2, rating3:value4, 
                 rating5:value6, rating7:value8), 
               names_to = c('.value', 'number'), names_pattern = ('(.*)(\\d+)')) %>%
  filter(!is.na(gender)) %>%
  mutate(
    chosen = case_when(
      choice_a == 'Immigrant 1 should be admitted.' & number == 1 ~ 1,
      choice_a == 'Immigrant 2 should be admitted.' & number == 2 ~ 1,
      choice_b == 'Immigrant 3 should be admitted.' & number == 3 ~ 1,
      choice_b == 'Immigrant 4 should be admitted.' & number == 4 ~ 1,
      choice_c == 'Immigrant 5 should be admitted.' & number == 5 ~ 1,
      choice_c == 'Immigrant 6 should be admitted.' & number == 6 ~ 1,
      choice_d == 'Immigrant 7 should be admitted.' & number == 7 ~ 1,
      choice_d == 'Immigrant 8 should be admitted.' & number == 8 ~ 1,
      T ~ 0),
    value_chosen = case_when(
      value_a == 'Immigrant 1 has greater shared values with the U.S.' & number == 1 ~ 1,
      value_a == 'Immigrant 2 has greater shared values with the U.S.' & number == 2 ~ 1,
      value_b == 'Immigrant 3 has greater shared values with the U.S.' & number == 3 ~ 1,
      value_b == 'Immigrant 4 has greater shared values with the U.S.' & number == 4 ~ 1,
      value_c == 'Immigrant 5 has greater shared values with the U.S.' & number == 5 ~ 1,
      value_c == 'Immigrant 6 has greater shared values with the U.S.' & number == 6 ~ 1,
      value_d == 'Immigrant 7 has greater shared values with the U.S.' & number == 7 ~ 1,
      value_d == 'Immigrant 8 has greater shared values with the U.S.' & number == 8 ~ 1,
      T ~ 0),
    sexuality = factor(ifelse(sexuality %in% c('lesbian', 'gay'), 'Lesbian or gay', 'Straight'), 
                       levels = c('Straight', 'Lesbian or gay')),
    across(c(gender, sexuality, gdp, skill, lang, religion, reason), function(x) factor(x)),
    across(c(rating, value), function(x) as.numeric(substr(x, 1,1)))) %>%
  mutate(skill = recode(skill, 
                        'has a high school degree, and works as a restaurant manager' = 
                          'high school',
                        'has a primary school education, and works as a cleaner' = 
                          'primary school',
                        'has an MD, and works as a cardiologist' = 'MD'),
         reason = recode(reason, 'could not find work due to high unemployment' = 
                           'could not find work'),
         resp_religion_full = resp_religion,
         resp_religion = factor(case_when(
           resp_religion %in% c('Other Christian', '
                                Protestant (Baptist, Methodist, Non-denominational, Lutheran, Presbyterian, Pentecostal, Episcopalian, Reformed, Church of Christ, Jehovah’s Witness, etc.)',
                                'Roman Catholic (Catholic)') ~ 'Christian',
           resp_religion %in% c('Agnostic (not sure if there is a God)',
                                'Atheist (do not believe in God)',
                                'Nothing in particular') ~ 'Atheist/not religious',
           T ~ 'Other')),
         resp_politics = factor(ifelse(
             resp_politics %in% c('Independent', 'None of these'), 'other',
             resp_politics)),
         resp_sexuality = factor(case_when(
           resp_sexuality %in% c("I don't know the answer", 'Something else') ~ 'Other',
           resp_sexuality %in% c('Bisexual', 'Lesbian or gay') ~ 'Lesbian/gay/bisexual',
           resp_sexuality == 'Straight (that is, not gay or lesbian)' ~ 'Straight'
         )),
         resp_education = factor(resp_education),
         resp_pro_econ = resp_imm_support_1,
         resp_pro_job = resp_imm_support_2,
         resp_pro_tax = resp_imm_support_3,
         resp_pro_culture = resp_imm_support_4,
         resp_pro_help = resp_imm_support_5,
         resp_con_econ = resp_imm_support_6,
         resp_con_job = resp_imm_support_7,
         resp_con_welfare = resp_imm_support_8,
         resp_con_crime = resp_imm_support_9,
         resp_con_pop = resp_imm_support_10,
         resp_con_culture = resp_imm_support_11
  ) %>%
  mutate(BA = factor(case_when(
    resp_education %in% c("Bachelor's degree", "Master's, doctorate, or other postgraduate degree") ~ 'BA',
    !is.na(resp_education) ~ 'no BA')),
    resp_overpop = factor(case_when(
      resp_con_pop %in% c('Agree', 'Somewhat agree') ~ 'Agree',
      resp_con_pop %in% c('Disagree', 'Somewhat disagree') ~ 'Disgree')),
    know_LG = factor(case_when(resp_knowlg %in% c('No, none', "I'm not sure") ~ 'No', 
                        T ~ 'Yes'))
    ) %>%
  left_join(mutate(prolific, resp_age = as.numeric(Age), 
                   resp_ethnicity = `Ethnicity simplified`, 
                   PROLIFIC_PID = `Participant id`) %>%
              select(-Status),
            by = 'PROLIFIC_PID') %>%
  mutate(party = resp_politics,
         age_cat = case_when(
           resp_age <= 29 ~ '18-29',
           resp_age %in% 30:49 ~ '30-49',
           resp_age %in% 50:64 ~ '50-64',
           resp_age >= 65 ~ '65+',
           is.na(resp_age) ~ 'Refused'),
         educ = case_when(
           resp_education %in% c("Bachelor's degree", 
                                 "Master's, doctorate, or other postgraduate degree") ~ "College graduate+",
           resp_education %in% c('High school', 'Less than high school') ~ "H.S. graduate or less",
           resp_education == 'Some college' ~ 'Some College'),
         gender_pew = case_when(
           resp_gender == 'Man' ~ 'A man',
           resp_gender == 'Woman' ~ 'A woman',
           resp_gender == 'Other' ~ 'In some other way')
         ) %>%
  mutate(across(c(gdp, lang, reason, gender, skill, religion), ~as.factor(str_to_sentence(.x)))) %>%
  mutate(skill = as.factor(ifelse(skill == 'Md', 'MD', as.character(skill)))) %>% 
                        #levels = c('Primary school', 'High school', 'MD'))) %>%
  mutate(Sexuality = sexuality, 
         Gender = gender,
         GDP = gdp,
         Skill = skill,
         Language = lang,
         Religion = religion,
         Reason = reason) %>%
  filter(age_cat != 'Refused')

pew <- read_sav(here('data/W112_Jul22','ATP W112.sav')) %>%
  mutate(weight = WEIGHT_W112,
         party = as_factor(F_PARTY_FINAL),
         age_cat = as_factor(F_AGECAT),
         educ = as_factor(F_EDUCCAT),
         gender_pew = as_factor(F_GENDER)) %>%
  mutate(party = case_when(party %in% c('Independent', 'Something else') ~ 'other',
                                   party == 'Refused' ~ NA,
                                   T ~ party)) 

pew_survey <- as_survey_design(pew, weights = weight)
         
props <- pew_survey %>%
  group_by(party, age_cat, educ, gender_pew) %>%
  summarize(prop_pew = survey_prop()) %>%
  ungroup() %>%
  complete(party, age_cat, educ, gender_pew) %>%
  mutate(prop_pew = ifelse(is.na(prop_pew), 0, prop_pew)) %>%
  select(-prop_pew_se)


weights <- survey %>%
  count(party, age_cat, educ, gender_pew) %>%
  mutate(prop = n / nrow(survey)) %>%
  left_join(props) %>%
  mutate(weight = prop_pew / prop) %>%
  select(-c(n, prop, prop_pew))

survey <- survey %>%
  left_join(weights) 
```


# (APPENDIX) Appendix {-} 

\newpage

# Survey Instrument

A PDF of our full Qualtrics survey is available in the Supplementary Material. Below is material from the core of the survey, a vignette with accompanying questions.


*Please carefully read the following two descriptions of potential immigrants to the United States. Then indicate which one you personally would prefer to see admitted to the United States.*  


> Immigrant [1/2] wishes to be admitted as an immigrant to the U.S. [He/she] comes from a [GDP] country, [Skill]. [He/she] [Language], is [Religion], and identifies as [Sexuality]. [He/she] had to leave [his/her] country because [he/she] [reason].  


Randomize:  
\begin{tabular}{p{0.3\linewidth}  p{0.5\linewidth}}
\hline
\bf{Attribute} & \bf{Vignette text} \\
\hline
Gender & \tabitem man \\
& \tabitem woman \\
 \\
Country GDP
& \tabitem moderately wealthy \\
& \tabitem low-income \\

 \\
Skill
& \tabitem has an MD and works as a cardiologist \\
& \tabitem has a high school degree and works as a restaurant manager \\
& \tabitem has a primary school education and works as a cleaner \\

 \\
Language
& \tabitem speaks English \\
& \tabitem does not speak English \\
 \\
Religion
& \tabitem Christian \\
& \tabitem Muslim \\

 \\
Sexuality
& \tabitem gay/lesbian \\
& \tabitem straight (that is, not gay/lesbian) \\
 \\
Reason for migration
& \tabitem feared government persecution \\
& \tabitem could not find work due to high unemployment \\
\hline
\end{tabular}

\newpage 

Example:  
\begin{tabular}{p{0.45\linewidth}  p{0.45\linewidth}}
\hline
\bf{Immigrant 1} & \bf{Immigrant 2} \\
\hline
Immigrant 1 is a woman from a moderately wealthy country. She has a primary school education and works as a teacher. She speaks English, is Muslim, and identifies as lesbian. She had to leave her country because she could not find work due to high unemployment.
& Immigrant 2 is a man from a low-income country. He has an MD and works as a cardiologist. He does not speak English, is Christian, and identifies as straight (that is, not gay). He had to leave his country because he feared government persecution. \\
 \hline
\end{tabular}  

\vspace{1cm}  

1. *Based on their descriptions, which of these two immigrants would you personally prefer to see admitted to the United States?*  

- Immigrant 1 should be admitted
- Immigrant 2 should be admitted
  
2. *Based on their descriptions, which of these two immigrants do you think has greater shared values with the United States?*  

- Immigrant 1 has greater shared values with the U.S.
- Immigrant 2 has greater shared values with the U.S.

\newpage

# Research Ethics
We undertook our survey in accordance with the American Political Science Association’s *Principles and Guidance for Human Subjects Research*. Both the pilot study and the main study received approval from the second author's university Institutional Review Board prior to data collection (Study ID 15408). The surveys did not contain any sensitive questions, the surveys did not involve deception, and respondent identities are anonymized in the data. Participation was voluntary, and respondents read and accepted an informed consent statement before completing the survey. Respondents received $1 for their participation in the pilot or main survey; we anticipated that respondents would complete the survey in 7:30 or less, corresponding to a pay rate above U.S. federal minimum wage. With average completion times of 3:50 for the pilot and 7:29 for the main survey, this pay rate was achieved.




\newpage

# Weighting Procedure

To re-weight the Prolific survey sample to be closer to the U.S. population, we construct inverse probability weights using the July-August 2022 American Trends Panel (Wave 112, n = `r nrow(pew)`), based on four variables: political party, age (in four categories), education, and gender. Unfortunately, Prolific does not provide an ethnicity variable that is suitable for U.S. data. Table \@ref(tab:desc-pew-prolific) present the distributions of the weighting variables in the Pew survey and our own Prolific survey.


```{r desc-pew-prolific}
bind_rows(
  pew %>%
    select(Party = party, `Age category` = age_cat, Education = educ, Gender = gender_pew) %>%
    mutate(survey = 'Pew'),
  survey %>%
  distinct(prolific_pid, .keep_all = T) %>%
  select(Party = party, `Age category` = age_cat, Education = educ, Gender = gender_pew) %>%
    mutate(survey = 'Prolific')
  ) %>%
  filter(Education != 'Refused', `Age category` != 'Refused', Gender != 'Refused') %>%
  mutate(Party = factor(ifelse(Party == 'other', 'Other', Party), levels = c('Democrat', 'Republican', 'Other')),
         Education = factor(Education, 
                            levels = c('H.S. graduate or less', 'Some College', 'College graduate+'))) %>%
  gtsummary::tbl_summary(by = survey, missing = 'no') %>%
  gtsummary::modify_footnote(everything() ~ NA) %>%
  gtsummary::as_hux_table() %>%
  huxtable::set_italic(c(2,6,11, 15), 1) %>%
  huxtable::theme_article() %>%
  #huxtable::set_width(1) %>%
  huxtable::set_all_padding(0) %>%
  huxtable::set_latex_float('h!') %>%
  huxtable::set_caption('Distributions of variables used for weighting in the Pew July-August 2022 American Trends Panel and in our 2023 survey experiment administered with Prolific. Table shows unweighted counts and, in parentheses, unweighted percentages within survey.') 
  
```


\newpage

# Unweighted Results

```{r amces, fig.cap = 'Unweighted AMCEs for admission and cultural similarity for all features Standard errors are clustered within respondent.'}

(plot(cj(survey, chosen ~  Sexuality + Gender + GDP + Skill + Language + Religion + Reason, 
        id = ~prolific_pid)) + 
   labs(title = 'Admission'))  + 
  (plot(cj(survey, value_chosen ~  Sexuality + Gender + GDP + Skill + Language + Religion + Reason, 
        id = ~prolific_pid))   +
     labs(title = 'Cultural Similarity') +
     theme(axis.text.y=element_blank())) +
     plot_layout(guides = 'collect') &
  theme(legend.position = 'bottom')

```



```{r mediation, fig.height = 3, fig.cap = 'Unweighted AMCEs for admission for sexuality, stratified by whether the profile received a 6 or 7 out of 7 on cultural similarity ratings'}
mediation_cj <- survey %>%
  mutate(top_value = factor(case_when(value >= 6 ~ '6 or 7 on cultural similarity',
                               T ~ '1 to 5 on cultural similarity'))) %>% 
  cj(., chosen ~ sexuality, id = ~prolific_pid, estimate = 'amce', 
             by = ~top_value)

mediation_cj %>%
  ggplot(aes(x = level, y = estimate)) +
  geom_pointrange(aes(ymin = lower, ymax = upper)) +
  geom_hline(aes(yintercept = ifelse(statistic == 'mm', 0.5, 0)), linewidth = .2) +
  coord_flip() +
  facet_wrap(~BY, nrow = 1) +
  labs(x = '', y = '')
```



```{r interaction,  fig.height = 3, fig.cap = 'Unweighted marginal means of the interaction between sexuality and the reason for migration'}
int_cj <- cj(survey, chosen ~ sexuality, id = ~prolific_pid, estimate = 'mm', 
             by = ~reason)
int_cj_dif <- cj(survey, chosen ~ sexuality, id = ~prolific_pid, estimate = 'mm_diff', 
                 by = ~reason)

rbind(int_cj, int_cj_dif) %>%
  mutate(BY = recode(BY, 'Could not find work' = 'Work',
                     'Feared government persecution' = 'Persecution',
                     'Feared government persecution - Could not find work' = 
                       'Persecution - Work')) %>%
  ggplot(aes(x = level, y = estimate)) +
  geom_pointrange(aes(ymin = lower, ymax = upper)) +
  geom_hline(aes(yintercept = ifelse(statistic == 'mm', 0.5, 0)), linewidth = .2) +
  coord_flip() +
  facet_wrap(~BY, nrow = 1) +
  labs(x = '', y = '')
```



```{r mm, fig.height = 6, fig.cap = 'Unweighted marginal means for heterogeneous effects by respondent characteristics. Standard errors are clustered within respondent.'}
cj(mutate(survey, educ = factor(educ, 
                  levels = c('H.S. graduate or less', 'Some College', 'College graduate+'))), 
                chosen ~ sexuality, estimate = 'mm',
        id = ~prolific_pid, by = ~educ) %>%
  mutate(variable = 'Education',
         values = educ) %>%
  bind_rows(
    cj(mutate(survey, resp_politics = factor(str_to_sentence(resp_politics), 
                  levels = c('Democrat', 'Republican', 'Other'))), 
                chosen ~ sexuality, estimate = 'mm',
        id = ~prolific_pid, by = ~resp_politics) %>%
      mutate(variable = 'Politics',
             values = resp_politics)) %>%
  bind_rows(
    cj(survey, chosen ~ sexuality, estimate = 'mm',
        id = ~prolific_pid, by = ~resp_religion) %>%
      mutate(variable = 'Religion',
             values = resp_religion)) %>%
  bind_rows(
    cj(mutate(survey, resp_sexuality = factor(ifelse(resp_sexuality == 'Straight', 
                                                 'Straight', 
                                                 'Lesbian/gay/bi/other'))), 
                chosen ~ sexuality, estimate = 'mm',
        id = ~prolific_pid, by = ~resp_sexuality) %>%
      mutate(variable = 'Sexuality',
             values = resp_sexuality)) %>%
  bind_rows(
    cj(survey, chosen ~ sexuality, estimate = 'mm',
        id = ~prolific_pid, by = ~resp_overpop) %>%
      mutate(variable = 'Overpopulation Concerns',
             values = resp_overpop)) %>%
  bind_rows(
    cj(mutate(survey, know_LG = factor(know_LG, levels = c('Yes', 'No'))), 
   chosen ~ sexuality, estimate = 'mm',
        id = ~prolific_pid, by = ~know_LG) %>%
     mutate(variable = 'Know LG',
            values = know_LG)) %>%
  mutate(variable = factor(variable, levels = unique({.$variable})),
         values = factor(values, levels = rev(unique({.$values})))) %>%
  ggplot(aes(x = values, y = estimate, color = level, shape = level)) +
  geom_pointrange(position = position_dodge(-0.5), aes(ymin = lower, ymax = upper)) +
  geom_hline(yintercept = .5, linewidth = .2) +
  facet_wrap(~variable, scales = 'free_y', nrow = 3) +
  coord_flip() +
  labs(x = '', y = '') +
  theme(legend.position = 'bottom')



```

\newpage

# Heterogeneous Effects for Cultural Similarity (Marginal Means)

```{r mm-values, fig.height = 6, fig.cap = 'Marginal means for heterogeneous effects of considering more culturally similar, by respondent characteristics. Standard errors are clustered within respondent.'}
cj(mutate(survey, educ = factor(educ, 
                  levels = c('H.S. graduate or less', 'Some College', 'College graduate+'))), 
                value_chosen ~ sexuality, estimate = 'mm',
        weights = ~weight, id = ~prolific_pid, by = ~educ) %>%
  mutate(variable = 'Education',
         values = educ) %>%
  bind_rows(
    cj(mutate(survey, resp_politics = factor(str_to_sentence(resp_politics), 
                  levels = c('Democrat', 'Republican', 'Other'))), 
                value_chosen ~ sexuality, estimate = 'mm',
        weights = ~weight, id = ~prolific_pid, by = ~resp_politics) %>%
      mutate(variable = 'Politics',
             values = resp_politics)) %>%
  bind_rows(
    cj(survey, value_chosen ~ sexuality, estimate = 'mm',
        weights = ~weight, id = ~prolific_pid, by = ~resp_religion) %>%
      mutate(variable = 'Religion',
             values = resp_religion)) %>%
  bind_rows(
    cj(mutate(survey, resp_sexuality = factor(ifelse(resp_sexuality == 'Straight', 
                                                 'Straight', 
                                                 'Lesbian/gay/bi/other'))), 
                value_chosen ~ sexuality, estimate = 'mm',
        weights = ~weight, id = ~prolific_pid, by = ~resp_sexuality) %>%
      mutate(variable = 'Sexuality',
             values = resp_sexuality)) %>%
  bind_rows(
    cj(survey, value_chosen ~ sexuality, estimate = 'mm',
        weights = ~weight, id = ~prolific_pid, by = ~resp_overpop) %>%
      mutate(variable = 'Overpopulation Concerns',
             values = resp_overpop)) %>%
  bind_rows(
    cj(mutate(survey, know_LG = factor(know_LG, levels = c('Yes', 'No'))), 
   value_chosen ~ sexuality, estimate = 'mm',
        weights = ~weight, id = ~prolific_pid, by = ~know_LG) %>%
     mutate(variable = 'Know LG',
            values = know_LG)) %>%
  mutate(variable = factor(variable, levels = unique({.$variable})),
         values = factor(values, levels = rev(unique({.$values})))) %>%
  ggplot(aes(x = values, y = estimate, color = level, shape = level)) +
  geom_pointrange(position = position_dodge(-0.5), aes(ymin = lower, ymax = upper)) +
  geom_hline(yintercept = .5, linewidth = .2) +
  facet_wrap(~variable, scales = 'free_y', nrow = 3) +
  coord_flip() +
  labs(x = '', y = '') +
  theme(legend.position = 'bottom')






```

\newpage

# Additional Interactions for Admission

```{r interaction-all, fig.height = 7, fig.cap = 'Marginal means of the interaction between sexuality and other features'}
bind_rows(
  cj(survey, chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'mm', 
             by = ~Gender),
  cj(survey, chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'mm_diff', 
                 by = ~Gender),
  cj(survey, chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'mm', 
             by = ~GDP),
  cj(survey, chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'mm_diff', 
                 by = ~GDP),
  cj(mutate(survey, Skill = factor(Skill, levels = c('Primary school', 'High school', 'MD'))), 
     chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'mm', 
             by = ~Skill) %>%
    filter(BY != 'High school'),
  cj(mutate(survey, Skill = factor(Skill, levels = c('Primary school', 'High school', 'MD'))), 
     chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'mm_diff', 
                 by = ~Skill) %>%
    filter(BY == 'MD - Primary school'),
  cj(survey, chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'mm', 
             by = ~Language),
  cj(survey, chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'mm_diff', 
                 by = ~Language),
  cj(survey, chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'mm', 
             by = ~Religion),
  cj(survey, chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'mm_diff', 
                 by = ~Religion),
  cj(survey, chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'mm', 
             by = ~Reason),
  cj(survey, chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'mm_diff',
                 by = ~Reason)
) %>%
  mutate(BY = recode(BY, 
                     'Could not find work' = 'Work',
                     'Feared government persecution' = 'Persecution',
                     'Feared government persecution - Could not find work' = 'Persecution - Work',
                     'Does not speak english' = 'No English',
                     'Speaks english' = 'English',
                     'Speaks english - Does not speak english' = 'English - No English',
                     'Moderately wealthy - Low-income' = 'Moderate - Low-income')) %>%
  mutate(BY = factor(BY, levels = unique({.$BY}))) %>%
  ggplot(aes(x = level, y = estimate)) +
  geom_pointrange(aes(ymin = lower, ymax = upper)) +
  geom_hline(aes(yintercept = ifelse(statistic == 'mm', 0.5, 0)), linewidth = .2) +
  coord_flip() +
  facet_wrap(~BY, ncol = 3) +
  labs(x = '', y = '')


```

\newpage



# Full Tables for Results from Main Paper

```{r amces-admission-tab}
cj(survey, chosen ~  Sexuality + Gender + GDP + Skill + Language + Religion + Reason, 
        weights = ~weight, id = ~prolific_pid) %>%
  mutate(estimate = ifelse(estimate == 0.00000000, NA, estimate)) %>%
  mutate_if(is.numeric, round, 3) %>%
  mutate_if(is.numeric, format, nsmall=3) %>%
  select(Feature = feature, Level = level, Estimate = estimate, SE = std.error, `p-value` = p) %>%
  kableExtra::kable(booktabs = T, linesep = '', caption = 'Estimated  AMCEs for admission for all features. Standard errors are clustered within respondent.') %>%
kableExtra::kable_styling(latex_options = "HOLD_position")

```



```{r amces-culture-tab}
cj(survey, value_chosen ~  Sexuality + Gender + GDP + Skill + Language + Religion + Reason, 
        weights = ~weight, id = ~prolific_pid) %>%
  mutate(estimate = ifelse(estimate == 0.00000000, NA, estimate)) %>%
  mutate_if(is.numeric, round, 3) %>%
  mutate_if(is.numeric, format, nsmall=3) %>%
  select(Feature = feature, Level = level, Estimate = estimate, SE = std.error, `p-value` = p) %>%
  kableExtra::kable(booktabs = T, linesep = '', caption = 'Estimated  AMCEs for cultural similarity for all features. Standard errors are clustered within respondent.') %>%
kableExtra::kable_styling(latex_options = "HOLD_position")

```


```{r mediation-tab}
survey %>%
  mutate(top_value = factor(case_when(value >= 6 ~ '6 or 7 on cultural similarity',
                               T ~ '1 to 5 on cultural similarity'))) %>% 
  cj(., chosen ~ sexuality, weights = ~weight, id = ~prolific_pid, estimate = 'amce', 
             by = ~top_value) %>%
  mutate(estimate = ifelse(estimate == 0.00000000, NA, estimate)) %>%
  mutate_if(is.numeric, round, 3) %>%
  mutate_if(is.numeric, format, nsmall=3) %>%
  select(Subset = BY, Level = level, Estimate = estimate, SE = std.error, `p-value` = p) %>%
  kableExtra::kable(booktabs = T, linesep = '', caption = 'AMCEs for admission for sexuality, stratified by whether the profile received a 6 or 7 out of 7 on cultural similarity ratings.') %>%
kableExtra::kable_styling(latex_options = "HOLD_position")


```


```{r interaction-tab}
rbind(int_cj, int_cj_dif) %>%
  mutate(BY = recode(BY, 'Could not find work' = 'Work',
                     'Feared government persecution' = 'Persecution',
                     'Feared government persecution - Could not find work' = 
                       'Persecution - Work')) %>%
  select(Subset = BY, Level = level, Estimate = estimate, SE = std.error, `p-value` = p) %>%
  mutate_if(is.numeric, round, 3) %>%
  mutate_if(is.numeric, format, nsmall=3) %>%
  kableExtra::kable(booktabs = T, linesep = '', caption = 'Marginal means of the interaction between sexuality and the reason for migration.') %>%
kableExtra::kable_styling(latex_options = "HOLD_position")
```

```{r mm-tab}
cj(mutate(survey, educ = factor(educ, 
                  levels = c('H.S. graduate or less', 'Some College', 'College graduate+'))), 
                chosen ~ sexuality, estimate = 'mm',
        weights = ~weight, id = ~prolific_pid, by = ~educ) %>%
  mutate(variable = 'Education',
         values = educ) %>%
  bind_rows(
    cj(mutate(survey, resp_politics = factor(str_to_sentence(resp_politics), 
                  levels = c('Democrat', 'Republican', 'Other'))), 
                chosen ~ sexuality, estimate = 'mm',
        weights = ~weight, id = ~prolific_pid, by = ~resp_politics) %>%
      mutate(variable = 'Politics',
             values = resp_politics)) %>%
  bind_rows(
    cj(survey, chosen ~ sexuality, estimate = 'mm',
        weights = ~weight, id = ~prolific_pid, by = ~resp_religion) %>%
      mutate(variable = 'Religion',
             values = resp_religion)) %>%
  bind_rows(
    cj(mutate(survey, resp_sexuality = factor(ifelse(resp_sexuality == 'Straight', 
                                                 'Straight', 
                                                 'Lesbian/gay/bi/other'))), 
                chosen ~ sexuality, estimate = 'mm',
        weights = ~weight, id = ~prolific_pid, by = ~resp_sexuality) %>%
      mutate(variable = 'Sexuality',
             values = resp_sexuality)) %>%
  bind_rows(
    cj(survey, chosen ~ sexuality, estimate = 'mm',
        weights = ~weight, id = ~prolific_pid, by = ~resp_overpop) %>%
      mutate(variable = 'Overpopulation Concerns',
             values = resp_overpop)) %>%
  bind_rows(
    cj(mutate(survey, know_LG = factor(know_LG, levels = c('Yes', 'No'))), 
   chosen ~ sexuality, estimate = 'mm',
        weights = ~weight, id = ~prolific_pid, by = ~know_LG) %>%
     mutate(variable = 'Know LG',
            values = know_LG)) %>%
  mutate(variable = factor(variable, levels = unique({.$variable})),
         values = factor(values, levels = rev(unique({.$values})))) %>%
  select(`Respondent Attribute` = BY, Level = level, Estimate = estimate, SE = std.error, `p-value` = p) %>%
  mutate_if(is.numeric, round, 3) %>%
  mutate_if(is.numeric, format, nsmall = 3) %>%
  kableExtra::kable(booktabs = T, linesep = '', caption = 'Marginal means for heterogeneous effects by respondent characteristics. Standard errors are clustered within respondent.') %>%
kableExtra::kable_styling(latex_options = "HOLD_position")
  
```

\newpage

# Pilot Study Results

On January 31, 2023, we conducted a pilot study of 100 respondents using Prolific, showing each respondent two sets of profiles. For LG profiles, we see an AMCE effect size of 0.032 in the expected direction (Figure \@ref(fig:pilot-general)); respondents are 3.2 percent more likely to choose a gay or lesbian immigrant for admission to the U.S. Furthermore, there is evidence of an interaction between sexuality and reason for departure: LG profiles fleeing persecution are more likely to be chosen than straight ones fleeing persecution (Figure \@ref(fig:pilot-interaction)). Subgroup analyses show that respondents without a bachelor's degree, Republicans, Christians, and straight respondents see LG migrants as less deserving (Figure \@ref(fig:pilot-subgroups)). 

```{r pilot-load}
prolific_demo <- read_csv(here('pilot', 'prolific_demo.csv')) %>%
  filter(Status == 'APPROVED')
pilot_raw <- read_csv(here('pilot', 'pilot.csv')) %>%
  filter(prolific_pid %in% prolific_demo$`Participant id`) %>%
  filter(str_detect(tolower(attention_color_5_TEXT), 'green') & 
           (str_detect(as.character(attention_number_6_TEXT), '9') | 
              str_detect(tolower(as.character(attention_number_6_TEXT)), 'nine'))
         )

pilot <- pilot_raw %>%
  #mutate(choice1 = Q3, choice2 = Q3, choice3 = Q13, choice4 = Q13) %>%
  pivot_longer(c(gender1:reason4, rating1:value2, rating3:value4), 
               names_to = c('.value', 'number'), names_pattern = ('(.*)(\\d+)')) %>%
  filter(!is.na(gender)) %>%
  # select(starts_with('choice_', starts_with('sexuality')))
  mutate(chosen = case_when(
    choice_a == 'Immigrant 1 should be admitted.' & number == 1 ~ 1,
    choice_a == 'Immigrant 2 should be admitted.' & number == 2 ~ 1,
    choice_b == 'Immigrant 3 should be admitted.' & number == 3 ~ 1,
    choice_b == 'Immigrant 4 should be admitted.' & number == 4 ~ 1,
    T ~ 0),
    sexuality = factor(ifelse(sexuality %in% c('lesbian', 'gay'), 'lesbian or gay', 'straight'), 
                       levels = c('straight', 'lesbian or gay')),
    across(c(gender, sexuality, gdp, skill, lang, religion, reason), function(x) factor(x)),
    across(c(rating, value), function(x) as.numeric(substr(x, 1,1)))) %>%
  mutate(skill = recode(skill, 
                        'has a high school degree, and works as a restaurant manager' = 
                          'high school',
                        'has a primary school education, and works as a cleaner' = 
                          'primary school',
                        'has an MD, and works as a cardiologist' = 'MD'),
         reason = recode(reason, 'could not find work due to high unemployment' = 
                           'could not find work'),
         resp_religion = factor(case_when(
           resp_religion %in% c('Other Christian', '
                                Protestant (Baptist, Methodist, Non-denominational, Lutheran, Presbyterian, Pentecostal, Episcopalian, Reformed, Church of Christ, Jehovah’s Witness, etc.)',
                                'Roman Catholic (Catholic)') ~ 'Christian',
           resp_religion %in% c('Agnostic (not sure if there is a God)',
                                'Atheist (do not believe in God)',
                                'Nothing in particular') ~ 'Atheist/not religious',
           T ~ 'Other')),
         resp_politics = factor(ifelse(
             resp_politics %in% c('Independent', 'None of these'), 'other',
             resp_politics)),
         resp_sexuality = factor(case_when(
           resp_sexuality %in% c("I don't know the answer", 'Something else') ~ 'Other',
           resp_sexuality %in% c('Bisexual', 'Lesbian or gay') ~ 'Lesbian/gay/bisexual',
           resp_sexuality == 'Straight (that is, not gay or lesbian)' ~ 'Straight'
         )),
         resp_education = factor(resp_education)
  )


# pilot <- pilot %>% slice(rep(row_number(), each = 10)) %>%
#   mutate(prolific_pid = 1:n())

```


```{r pilot-general, fig.height = 3, fig.cap = 'Estimated marginal means and AMCEs for Prolific pilot study of 100 respondents each shown 2 sets of profiles. Standard errors are clustered within respondent.'}
(plot(mm(pilot, chosen ~  sexuality, 
        id = ~prolific_pid)) + geom_vline(xintercept = 0.5, linewidth = .2)) +
  plot(cj(pilot, chosen ~  sexuality, 
        id = ~prolific_pid)) &
  theme()
```

```{r pilot-interaction, fig.height = 3, fig.cap = 'Marginal means of the interaction between sexuality and the reason for migration'}
int_cj <- cj(pilot, chosen ~ sexuality, id = ~prolific_pid, estimate = 'mm', 
             by = ~reason)
int_cj_dif <- cj(pilot, chosen ~ sexuality, id = ~prolific_pid, estimate = 'mm_diff', 
                 by = ~reason)
rbind(int_cj, int_cj_dif) %>%
  mutate(BY = recode(BY, 'could not find work' = 'work',
                     'feared government persecution' = 'persecution',
                     'feared government persecution - could not find work' = 
                       'persecution - work')) %>%
  plot() + 
  ggplot2::facet_wrap(~BY, ncol = 3) +
  # geom_vline(xintercept = 0.5, linewidth = .2)
  geom_vline(aes(xintercept = ifelse(statistic == 'mm', 0.5, 0)), linewidth = .2)
```


```{r pilot-subgroups, fig.height = 5, fig.cap = 'Marginal means for subgroups'}
pilot <- pilot %>%
  mutate(BA = factor(case_when(
    resp_education == "Bachelor's degree or higher" ~ 'BA',
    resp_education != "Bachelor's degree or higher" ~ 'no BA',
  )))

(plot(cj(pilot, chosen ~ sexuality, estimate = 'mm',
        id = ~prolific_pid, by = ~ BA),
        group = 'BA') +
  geom_vline(xintercept = .5, linewidth = .2) +
  theme(legend.position = 'right')) /
(plot(cj(pilot, chosen ~ sexuality, estimate = 'mm',
        id = ~prolific_pid, by = ~ resp_politics),
        group = 'resp_politics') +
  geom_vline(xintercept = .5, linewidth = .2) +
  theme(legend.position = 'right')) /
(plot(cj(pilot, chosen ~ sexuality, estimate = 'mm',
        id = ~prolific_pid, by = ~resp_religion),
        group = 'resp_religion') +
  geom_vline(xintercept = .5, linewidth = .2) +
  theme(legend.position = 'right')) /
(plot(cj(pilot, chosen ~ sexuality, estimate = 'mm',
        id = ~prolific_pid, by = ~ resp_sexuality),
        group = 'resp_sexuality') +
  geom_vline(xintercept = .5, linewidth = .2) +
  theme(legend.position = 'right'))
```
